perm filename M11C.OL2[M11,LCS] blob
sn#409381 filedate 1979-01-07 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C00021 ENDMK
Cā;
CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C *** MUSIC V ***
SUBROUTINE FORSAM
DIMENSION ENVP(27)
C ENVP STORES POINTERS FOR 'ENV' ARRAY. SEE AT 105 FOR INFO.
COMMON /LM/L(10),M(10),NSAMX
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
COMMON I(1) /P/P(1) /GENS/GENS(1) /LFUNC/LFUNC,XNFUN
1 /XIN/AMP,FREQ
COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2 L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(AMP,XIN1),(FREQ,XIN2)
3 ,(I5,I(5)),(I6,I(6)),(I3,I(3)),(L9,L(9))
CC XNFUN=LFUNC-1
C COMMON INITIALIZATION OF GENERATORS
CX N1=I6+2
C I6 HAS POINTER TO CODE (IN INS ARRAY) FOR U.G. NOW TO BE PROCESSED.
CX N2=INS(N1-1)-1
CX DO 204 J1=N1,N2
CX J2=J1-N1+1
CX IF(INS(J1).GE.0)GO TO 201
CX200 L(J2)=-INS(J1)
CX M(J2)=1
CX GO TO 204
CX201 M(J2)=0
CX IF(INS(J1)-26262.GT.0)GO TO 203
C***** WHAT DOES THE BIG NUMBER DO?????
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
CX202 L(J2)=INS(J1)+I3-1
CX GO TO 204
CX203 L(J2)=INS(J1)-26262
CX204 CONTINUE
CX N3=INS(I6)
CX IF(M1.LE.0)AMP=RNT(L1)
CX IF(M2.LE.0)FREQ=RNT(L2)
CX J3= N3 -100
CALL INITIT(J3)
AMP=RNT(L1)
FREQ=RNT(L2)
NSAM=I5
NSAMX=NSAM-1
C OUT OSC AD2 RAI ENV STR AD3 AD4 MLT DIV RAH
GO TO (101,102,103,104,105,106,107,108,109,110,111,112,113,114,
1 115,116),J3
CC IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C SUBROUTINE OPT(L,M,NSAM)
C DIMENSION L(8),M(8)
C COMMON /GENS/GENS(1)/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
112 CALL OPT(J1,J2,J3)
113 RETURN
114 RETURN
C UNIT GENERATORS
C OUTPUT BOX
CX 101 IF(M1.LE.0)IN1=RNT(L1)
CX DO 270 J3=0,NSAM-1
CX IF(M1.GT.0)IN1=ROUT(J3+L1)
CX 265 J5=L2+J3
CX ROUT(J5)=IN1+ROUT(J5)
CX 270 CONTINUE
CX RETURN
101 CALL OUTP
C CALLS 'FAIL' OUT BOX
RETURN
CC101 DO 270 K=0,NSAMX
J5=L2+K
270 ROUT(J5)=ROUT(J5)+ROUT(K+L1)
RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
C OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102 CALL OSC
C CALL 'FAIL' OSC.
RETURN
CXX 102 SUM=RNT(L5)
CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
CC IF(M1.LE.0)AMP=RNT(L1)
CC IF(M2.LE.0)FREQ=RNT(L2)
DO 293 J3=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 286
SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3
SUM=SUM+ROUT(J4)
290 IF(SUM.GE.XNFUN)SUM=SUM-XNFUN
CC290 IF(SUM.GE.XNFUN)GO TO 287
CC IF(SUM.LT.0.0)GO TO 289
288 J5=L3+J3
IF(M1.GT.0)GO TO 292
ROUT(J5)=AMP*F
GO TO 293
C**********
CC287 SUM=SUM-XNFUN
CC GO TO 288
CC289 SUM=SUM+XNFUN
CC GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
292 J6=L1+J3
ROUT(J5)=ROUT(J6)*F
293 CONTINUE
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
C 115 NEG OSCILLATOR L1,L2 = P or B L3=B L4=F or P L5=P
C 'NOS' AMPL, TIME, OUTPUT, FUNC, 5TH NO LONGER USED.
C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
115 SUM=RNT(L5)
CALL LOCGEN(M4,L4)
C FINDS POINTER TO FUNC NUM. IF M4.EQ.1 THEN FNUM WAS IN INST DEF.
CC IF(M1.LE.0)AMP=RNT(L1)
CC IF(M2.LE.0)FREQ=RNT(L2)
DO 150 J3=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 151
SUM=SUM+FREQ
GO TO 152
151 J4=L2+J3
SUM=SUM+ROUT(J4)
152 IF(SUM.GE.XNFUN)GO TO 153
IF(SUM.LT.0.0)GO TO 154
155 J5=L3+J3
IF(M1.GT.0)GO TO 156
ROUT(J5)=AMP*F
GO TO 150
C**********
153 SUM=SUM-XNFUN
GO TO 155
154 SUM=SUM+XNFUN
GO TO 155
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
156 J6=L1+J3
ROUT(J5)=ROUT(J6)*F
150 CONTINUE
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
C ADD TWO BOX
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
CC103 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
103 DO 258 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
ROUT(J3+L3)=XIN1+XIN2
258 CONTINUE
RETURN
C 116 SUBTRACT
CC116 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
116 DO 1016 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
ROUT(J3+L3)=XIN1-XIN2
1016 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
C M1=0=Pn M1=1=Bn
104 SUM=RNT(L4)
RN1=RNT(L5)
RN3=RNT(L6)
CC IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
IF(SUM.NE.0)GO TO 313
CALL RNDM(RN1)
CALL RNDM(RN3)
C INIT THE RANDOM NUMBERS.
313 DO 340 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
IF(XNFUN.GT.SUM)GO TO 320
CC IF(SUM-XNFUN.LT.0)GO TO 320
SUM=SUM-XNFUN
CALL RNDM(RN4)
304 RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)
SUM=SUM+XIN2
340 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN1
RNT(L6)=RN3
RETURN
C ENVELOPE GENERATOR ENV PorB, ForP, B, P, P, P, P, P;
C AMPL FUNC OUT ATCK STDY DCAY FLAG STOR
C FLAG=1=NO CONTINUATION, REINITS FOR EACH NOTE AND CAN PLAY ON TOP OF SELF.
C FLAG=0=INIT CONTINUATION FOR SEVERAL NOTES UNDER 1 ENV.
C (USE DIFFERENT INS. NUMS FOR CHORDS!!)
105 L9=RNT(L1-3)
C GET INS. NUM.
ENVX=RNT(L7)
IF(ENVX)805,605,905
905 SUM=RNT(L8)
GO TO 705
805 SUM=ENVP(L9)
GO TO 705
605 SUM=0
RNT(L7)=-1.
705 CALL LOCGEN(M2,L2)
C FINDS POINTER TO FUNC NUM. IF M2.EQ.1 THEN FNUM WAS IN INST DEF.
XIN4=RNT(L4)
XIN5=RNT(L5)
XIN6=RNT(L6)
XIN5=1./(1./XIN5 - 1./XIN4 -1./XIN6 )
C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
C STEADY STATE TIME IS COMPUTED
CC IF(M1.LE.0)AMP =RNT(L1)
CX IF(M4.LE.0)XIN4=FLOAT(RNT(L4))*SFI
CX IF(M5.LE.0)XIN5=FLOAT(RNT(L5))*SFI
CX IF(M6.LE.0)XIN6=FLOAT(RNT(L6))*SFI
XIN4=XIN4/4.
XIN5=XIN5/4.
XIN6=XIN6/4.
387 X1=XNFUN/4.
X2=2.*X1
X3=3.*X1
DO 205 J3=0,NSAMX
J4=INT(SUM)+L2
F=GENS(J4)
IF(M1.GT.0)AMP =ROUT(J3+L1)
IF(SUM-XNFUN.GE.0)SUM=SUM-XNFUN
IF(SUM-X1.GT.0)GO TO 305
CX IF(M4.GT.0)XIN4=FLOAT(ROUT(J3+L4))
SUM=SUM+XIN4
GO TO 405
305 IF(SUM-X2.GT.0)GO TO 505
CX IF(M5.GT.0)XIN5=FLOAT(ROUT(J3+L5))
SUM=SUM+XIN5
GO TO 405
CX505 IF(M6.GT.0)XIN6=FLOAT(ROUT(J3+L6))
505 SUM=SUM+XIN6
405 J7=L3+J3
ROUT(J7)=AMP*F
205 CONTINUE
IF(ENVX.LE.0)GO TO 1005
RNT(L8)=SUM
RETURN
1005 ENVP(L9)=SUM
RETURN
C STEREO OUTPUT BOX L1,L2 = B L3=B1
C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
106 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 206 J3=1,NSSAM,2
J4=L1+ICT
XIN1=ROUT(J4)
306 J5=L3+J3-1
ROUT(J5)=XIN1+ROUT(J5)
506 J4=L2+ICT
XIN2=ROUT(J4)
406 J5=L3+J3
ROUT(J5)=XIN2+ROUT(J5)
206 ICT=ICT+1
RETURN
C STEREO OUTPUT BOX
CX106 IF(M1.GT.0)GO TO 501
CCC 106 IF(M1)500,500,501
CX 500 IN1=I(L1)
CX501 IF(M2.GT.0)GO TO 503
CCC 501 IF(M2)502,502,503
CX 502 IN2=I(L2)
CX 503 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
CX ICT=0
CX DO 206 J3=1,NSSAM,2
CX IF(M1.LE.0)GO TO 306
CCC IF(M1)306,306,504
CC*** 504 J4=L1+J3-1
CX504 J4=L1+ICT
CX IN1=I(J4)
CX 306 J5=L3+J3-1
CX I(J5)=IN1+I(J5)
CX IF(M2.LE.0)GO TO 406
CCC IF(M2)406,406,506
CC*** 506 J4=L2+J3-1
CX506 J4=L2+ICT
CX IN2=I(J4)
CX 406 J5=L3+J3
CX I(J5)=IN2+I(J5)
CX 206 ICT=ICT+1
CX RETURN
C ADD 3 BOX
CC107 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
107 IF(M3.LE.0)XIN3=RNT(L3)
DO 780 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(L1+J3)
IF(M2.GT.0)XIN2=ROUT(L2+J3)
IF(M3.GT.0)XIN3=ROUT(L3+J3)
ROUT(J3+L4)=XIN1+XIN2+XIN3
780 CONTINUE
RETURN
C ADD 4 BOX
CC 108 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
108 IF(M3.LE.0)XIN3=RNT(L3)
IF(M4.LE.0)XIN4=RNT(L4)
DO 880 K=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(L1+K)
859 IF(M2.GT.0)XIN2=ROUT(L2+K)
IF(M3.GT.0)XIN3=ROUT(L3+K)
863 IF(M4.GT.0)XIN4=ROUT(L4+K)
ROUT(L5+K)=XIN1+XIN2+XIN3+XIN4
880 CONTINUE
RETURN
C MULTIPLIER
CC109 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
109 DO 908 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
ROUT(J3+L3)=XIN1*XIN2
908 CONTINUE
RETURN
C 110 DIVIDER
CC110 IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
110 DO 1010 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
1010 ROUT(J3+L3)=XIN1/XIN2
RETURN
C SET NEW FUNCTION IN OSC OR ENV
CC 110 ILOC=N1+6
CC IF(INS(N1+1).EQ.105) ILOC=N1+4
CC JN1=I(3)+INS(N1)-1
CC IIN1=RNT(JN1)
CC IF(IIN1.GT.0) INS(ILOC)=-(IIN1-1)*LFUNC-1
C 'SET' NO LONGER NEEDED!!!! NOW 110 CAN BE USED FOR SOMETHING ELSE.
C RANDOM AND HOLD GENERATOR RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
C M1=0=Pn M1=1=Bn
111 SUM=RNT(L4)
CC IF(M1.LE.0)XIN1=RNT(L1)
CC IF(M2.LE.0)XIN2=RNT(L2)
913 RN=RNT(L5)
IF(SUM.EQ.0)CALL RNDM(RN)
C TO INIT RANDOM NUMB. (COULD THIS EVER LOSE?)
DO 940 J3=0,NSAMX
IF(M1.GT.0) XIN1=ROUT(J3+L1)
IF(M2.GT.0) XIN2=ROUT(J3+L2)
IF(XNFUN.GT.SUM)GO TO 920
CC IF(SUM-XNFUN.LT.0)GO TO 920
SUM=SUM-XNFUN
CALL RNDM(RN)
920 ROUT(J3+L3)=XIN1*RN
SUM=SUM+XIN2
940 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN
RETURN
END
SUBROUTINE RNDM(X)
X=2.*RAN(X)-1.
C SENDS BACK NUMBER BETWEEN -1 AND +1
END
SUBROUTINE LOCGEN(M,L)
COMMON /NT/RNT(1) /LOCG/LOCG(1)
IF(M.EQ.0)L=LOCG(INT(RNT(L)))
C GET POINTER TO START OF FUNC. ARRAY
END
SUBROUTINE OPT(L,M,NSAM)
DIMENSION L(1),M(1)
COMMON /GENS/GENS(1)/LFUNC/LFUNC,XNFUN
1/NT/RNT(1)/ROUT/ROUT(1)
C THIS IS A DUMMY ROUTINE OPT Pm Pn Bn; doubles value of Bn
J1=L(3)
C L(3) MEANS LOOK AT 3RD FIELD OF 'OPT'
J2=J1+NSAM-1
DO 1 K=J1,J2
1 ROUT(K)=ROUT(K)*2
RETURN
END